home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 071-080 / amok77 / easyrexx / easyrexx.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  286 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       EasyRexx
  3.   :Contents.      easily add an Arexx Port to an Application
  4.   :Author.        Fridtjof Siebert [fbs]
  5.   :Author.        Kai Bolay [kai]
  6.   :Address.       Snail-Mail:              E-Mail:
  7.   :Address.       Hoffmannstraße 168       UUCP: kai@amokle.adsp.sub.org
  8.   :Address.       D-7250 Leonberg 1        FIDO: 2:2407/106.3
  9.   :History.       v1.0 [fbs] 11-Aug-91 created
  10.   :History.       v1.1 [kai] 13-Nov-92 uppecase commands -> UISG, GC
  11.   :Copyright.     Freeware
  12.   :Language.      Oberon
  13.   :Translator.    AMIGA OBERON v3.0d
  14. ------------------------------------------------------------------------ *)
  15. MODULE EasyRexx;
  16.  
  17. IMPORT rsl := RexxSysLib,
  18.        e * := Exec,
  19.        es  := ExecSupport,
  20.        rx  := Rexx,
  21.        str := Strings,
  22.        (* $IF GarbageCollector *)
  23.        avl := AVL;
  24.        (* $ELSE *)
  25.        avl := UntracedAVL;
  26.        (* $END *)
  27.  
  28. CONST
  29.   errorImGone = 100;
  30.   errorNoCmd  = 30;
  31.  
  32. TYPE
  33.   String * = e.STRING;
  34.  
  35.   (* $IF GarbageCollector *)
  36.   RexxCommandPtr * = POINTER TO RexxCommand;
  37.   (* $ELSE *)
  38.   RexxCommandPtr * = UNTRACED POINTER TO RexxCommand;
  39.   (* $END *)
  40.  
  41.   UserProc * = PROCEDURE(comm: RexxCommandPtr;
  42.                          args: String;
  43.                          VAR result: String);
  44.  
  45.   RexxCommand * = RECORD (avl.SNode)
  46.                     proc * : UserProc;
  47.                   END;
  48.  
  49. VAR
  50.   rexxPort : e.MsgPortPtr;           (* this is *our* rexx port           *)
  51.   commands : avl.SRoot;              (* our command list (actually a tree *)
  52.  
  53.   outStandingRMsg : rx.RexxMsgPtr;   (* the outstanding Rexx message *)
  54.  
  55.  
  56. (*---------------------------------------------------------------------------*)
  57.  
  58.  
  59. PROCEDURE OpenRexx * (name: String): LONGSET;
  60. (*
  61.  * Öffnet AREXX-Port mit Namen 'name'. Ergebnis ist das Signal des Ports
  62.  * (bereits in der LONGSET-Memge gesetzt).
  63.  * Konnte der Port nicht geöffnet werden, weil ein Port mit gleichen Namen
  64.  * bereits existiert oder weil zu wenig Speicher vorhanden war, wird
  65.  * eine leere Menge zurückgegeben.
  66.  *)
  67.  
  68. VAR
  69.   (* $IF GarbageCollector *)
  70.   Name: POINTER TO String;
  71.   (* $ELSE *)
  72.   Name: UNTRACED POINTER TO String;
  73.   (* $END *)
  74.  
  75. BEGIN
  76.  
  77.   IF rexxPort = NIL THEN
  78.  
  79.     e.Forbid() ;
  80.       IF e.FindPort(name)=NIL THEN    (* existiert gleichnamiger Port? *)
  81.         NEW(Name);
  82.         IF Name#NIL THEN              (* Speicher für Name             *)
  83.           Name^ := name;
  84.           rexxPort := es.CreatePort(Name^, 0)  (* Port erzeugen        *)
  85.         END;
  86.       END;
  87.     e.Permit() ;
  88.  
  89.   END;
  90.  
  91.   IF rexxPort # NIL THEN
  92.  
  93.     RETURN LONGSET{rexxPort.sigBit}                (* Signalset zurück *)
  94.  
  95.   ELSE
  96.  
  97.     RETURN LONGSET{}                                      (* leere Set *)
  98.  
  99.   END;
  100.  
  101. END OpenRexx;
  102.  
  103.  
  104. (*---------------------------------------------------------------------------*)
  105.  
  106.  
  107. PROCEDURE AddCommand * (comm: RexxCommandPtr);
  108. (*
  109.  * Fügt ein REXX-Command an die Commandoliste an. comm muß auf eine mit
  110.  * NEW() allozierten RECORD zeigen. In dem RECORD müssen die Felder
  111.  * comm.name für den Commandoname und comm.proc für die aufzurufende
  112.  * Prozedur ausgefüllt werden. comm.proc bekommt die eigene Struktur
  113.  * comm als ersten Parameter übergeben, so daß man durch Erweiterung
  114.  * von comm noch weitere Werte an die Prozedur übergeben kann.
  115.  *
  116.  * Commandos mit gleichen Namen dürfen nur 1 mal mit AddCommand()
  117.  * aktiviert werden, ansonsten bricht das Programm mit rc=20 ab.
  118.  *
  119.  *)
  120.  
  121. BEGIN
  122.  
  123.   str.Upper (comm.name);
  124.   IF NOT avl.Add(commands,comm) THEN HALT(20) END;
  125.  
  126. END AddCommand;
  127.  
  128.  
  129. (*---------------------------------------------------------------------------*)
  130.  
  131.  
  132. PROCEDURE EasyAddCommand*(name: ARRAY OF CHAR; proc: UserProc): BOOLEAN;
  133. (*
  134.  * Fügt ähnlich AddCommand() ein REXX-Commando an Commandoliste an.
  135.  * Hier wird jedoch lediglich ein standard-RexxCommand erzeugt und
  136.  * das Record kann vom Benutzer nicht erweitert werden.
  137.  *
  138.  * Ergebnis ist FALSE, wenn zu wenig Speicher vorhanden war.
  139.  *
  140.  *)
  141.  
  142. VAR
  143.   comm: RexxCommandPtr;
  144.  
  145. BEGIN
  146.  
  147.   NEW(comm); IF comm=NIL THEN RETURN FALSE END;
  148.  
  149.   comm.proc := proc;
  150.   COPY(name,comm.name);
  151.   AddCommand(comm);
  152.  
  153.   RETURN TRUE;
  154.  
  155. END EasyAddCommand;
  156.  
  157.  
  158. (*---------------------------------------------------------------------------*)
  159.  
  160.  
  161. PROCEDURE HandleRexx*;
  162. (*
  163.  * Dies Prozedur bearbeitet ankommende Rexx-Commandos. Sie sollte immer dann
  164.  * aufgerufen werden, wenn man den Verdacht hat, daß REXX-Messages angekommen
  165.  * sein könnten. Dies ist z.B. nach dem Aufruf von Exec.Wait(SignalSet+XYZ)
  166.  * der Fall, wenn SignalSet der von OpenRexxPort() erhaltene LONGSET ist.
  167.  *
  168.  * HandleRexxMsg ruft die mit AddCommand() aktivierten Prozeduren auf.
  169.  *
  170.  *)
  171.  
  172. VAR
  173.   RexxMsg: rx.RexxMsgPtr;
  174.   name: avl.String;
  175.   args,result: String;
  176.   i : INTEGER;
  177.   comm: avl.NodePtr;
  178.  
  179. BEGIN
  180.  
  181.   IF rexxPort = NIL THEN RETURN END;         (* kein Port -> keine Msg *)
  182.  
  183.   LOOP
  184.  
  185.     RexxMsg := e.GetMsg(rexxPort);                (* nächste Msg holen *)
  186.     IF RexxMsg=NIL THEN EXIT END;          (* keine mehr, dann tschüß! *)
  187.  
  188.     args := RexxMsg.args[0]^;                  (* Argumentstring holen *)
  189.  
  190.     i := 0;            (* Führende Spaces und Sonderzeichen übergehen: *)
  191.     WHILE (args[i] # 0X) AND (args[i] <= " ") DO INC(i) END;
  192.     str.Delete(args,0,i);
  193.  
  194.     i := 0;                               (* Commandoname extrahieren: *)
  195.     WHILE (args[i] # 0X) AND (args[i] >  " ") DO INC(i) END;
  196.  
  197.     COPY(args,name);                         (* Commandoname nach name *)
  198.     name[i] := 0X;
  199.     str.Upper (name);
  200.  
  201.             (* Spaces und Sonderzeichen bis zum 1. Argument übergehen: *)
  202.     WHILE (args[i] # 0X) AND (args[i] <= " ") DO INC(i) END;
  203.     str.Delete(args,0,i);
  204.  
  205.     RexxMsg.result1 := 0 ;                        (* Result vorbelegen *)
  206.     RexxMsg.result2 := 0 ;
  207.  
  208.             (* Msg als unbearbeitet markieren, falls Command abbricht: *)
  209.     outStandingRMsg := RexxMsg ;
  210.  
  211.     comm := avl.SFind(commands,name);              (* Commando suchen: *)
  212.  
  213.     IF comm=NIL THEN                  (* nicht gefunden: Fehler melden *)
  214.  
  215.       RexxMsg.result1 := errorNoCmd;
  216.  
  217.     ELSE
  218.  
  219.       result := "";                       (* Ergebnisstring vorbelegen *)
  220.       WITH comm: RexxCommand DO
  221.         comm.proc(comm,args,result);             (* Commando ausführen *)
  222.       END;
  223.  
  224. (* Wenn Ergebnis vorhanden und von Rexx erwartet, Erbebnis abschicken: *)
  225.       IF (result#"") AND ODD(RexxMsg.action DIV rx.rxResult)  THEN
  226.         RexxMsg.result2 := rsl.CreateArgstring(result,str.Length(result));
  227.       END;
  228.  
  229.     END;   (* IF comm=NIL THEN ... ELSE *)
  230.  
  231.     outStandingRMsg := NIL;                      (* Msg ist bearbeitet *)
  232.     e.ReplyMsg(RexxMsg);                            (* und beantworten *)
  233.  
  234.   END;   (* LOOP, nach nächste Msg schauen. *)
  235.  
  236. END HandleRexx;  (* das war's *)
  237.  
  238.  
  239. (*---------------------------------------------------------------------------*)
  240.  
  241.  
  242. PROCEDURE CloseRexx*;
  243. (*
  244.  * Schließt mit OpenRexx() geöffneten AREXX-Port.
  245.  *)
  246.  
  247. VAR
  248.   name: e.STRPTR;
  249.  
  250. BEGIN
  251.   IF rexxPort=NIL THEN RETURN END;                        (* kein Port *)
  252.   IF outStandingRMsg#NIL THEN                   (* unbeantwortete Msg? *)
  253.     outStandingRMsg.result1 := errorImGone;          (* Fehler liefern *)
  254.     e.ReplyMsg(outStandingRMsg) ;                  (* und beantworten. *)
  255.     outStandingRMsg := NIL;
  256.   END;
  257.   e.Forbid;
  258.     LOOP
  259.       outStandingRMsg := e.GetMsg (rexxPort);
  260.       IF outStandingRMsg=NIL THEN EXIT END;
  261.       outStandingRMsg.result1 := errorImGone;        (* Fehler liefern *)
  262.       e.ReplyMsg(outStandingRMsg) ;                (* und beantworten. *)
  263.     END;
  264.     name := rexxPort.node.name;  (* Zeiger auf Portname (wg. Speicher) *)
  265.     es.DeletePort(rexxPort);                         (* Port schließen *)
  266.   e.Permit;
  267.   DISPOSE(name);                                     (* Name freigeben *)
  268.   rexxPort := NIL;
  269. END CloseRexx;
  270.  
  271.  
  272. (*---------------------------------------------------------------------------*)
  273.  
  274.  
  275. BEGIN                                              (* Initialisierung: *)
  276.  
  277.   avl.SInit(commands);
  278.   outStandingRMsg := NIL;
  279.   rexxPort := NIL;
  280.  
  281. CLOSE                                                      (* Cleanup: *)
  282.  
  283.   CloseRexx;
  284.  
  285. END EasyRexx.
  286.